home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / fqset < prev    next >
Text File  |  1996-06-01  |  13KB  |  410 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- fqset.sa: Sets which support partial element state queries.
  10. -------------------------------------------------------------------
  11. class FQSET{Q,T} < $ELT{T} is
  12.     -- Class to be inherited by hash array based sets of elements of
  13.     -- type T, which support queries of type Q that depend only on part
  14.     -- of the state of an element. Uses writebacks. 
  15.     -- 
  16.     -- Descendant will usually redefine: `query_test', `query_hash', and
  17.     -- `elt_hash'. More rarely, it may also redefine: `elt_eq' and  
  18.     -- `elt_nil'.
  19.     -- 
  20.     -- A table will never have two elements that are `elt_eq' to 
  21.     -- each other, though there may be many elements responding to
  22.     -- a particular query.
  23.     --
  24.     -- The tables grow by amortized doubling and so require writeback
  25.     -- when inserting and deleting elements.
  26.     -- The simple collision resolution allows us to support deletions,
  27.     -- but makes the behavior quadratic with poor hash functions.
  28.     -- Puts a sentinel at the end of the table to avoid one check while
  29.     -- searching.
  30.    private include COMPARE{T};
  31.    private include AREF{T};
  32.     
  33.     private attr hsize:INT;    -- Number of stored entries.
  34.     
  35.     private const load_ratio:INT:=4; -- Allow to be at most 1/load_ratio full
  36.     
  37.     -- We can't have an invariant here, because we want to be able to
  38.     -- destroy 'self' sometimes for efficiency.
  39.  
  40.     --invariant:BOOL is        
  41.     --    -- Class invariant.
  42.     --   return void(self) or hsize.is_bet(0,asize) end;
  43.     
  44.     query_test(q:Q,t:T):BOOL is
  45.     -- True if `t' satisfies the query posed by `q'.
  46.     -- Usually redefined in descendants.
  47.     return SYS::ob_eq(q,t) end;
  48.     
  49.     query_hash(q:Q):INT is
  50.     -- The hash value associated with the query `q'.
  51.     -- If an element satisfies `query_test(q,t)', then `query_hash(q)' 
  52.     -- must equal `elt_hash(t)'. Should produce full range of integers.
  53.     -- Usually redefined in descendants.      
  54.     typecase q when $HASH then return q.hash
  55.     else return SYS::id(q).hash end end;
  56.     
  57.     
  58.     create:SAME is return void end;
  59.  
  60.     create(n:INT):SAME 
  61.     -- Make a table capable of dealing with `n' elements. You can
  62.     -- simply insert into a void table to create one as well.
  63.     -- Self may be void.
  64.     pre n>=1 is 
  65.     r::=allocate(1.lshift((3*load_ratio*n/4).highest_bit+1)+1);
  66.     return r end;
  67.     
  68.     private allocate(n:INT):SAME is
  69.     -- Allocate `n' locations (must be power of 2 plus 1) and
  70.     -- initialize to `elt_nil'.
  71.     r::=new(n); 
  72.     if ~void(elt_nil) then loop r.aset!(elt_nil) end end;
  73.     return r end;
  74.     
  75.     size:INT is
  76.     -- Number of entries in the table. Self may be void.
  77.     if void(self) then return 0 else return hsize end end;
  78.     
  79.     copy:SAME is
  80.     -- A copy of self.
  81.     r:SAME; loop r:=r.insert(elt!) end; return r end;
  82.     
  83.     elt!:T is
  84.     -- Yield the elements in self in an arbitrary order. Do not insert
  85.     -- or delete from self while calling this. Self may be void.
  86.     if ~void(self) then 
  87.         loop r::=aelt!; 
  88.         if ~is_elt_nil(r) then yield r end end end end;
  89.  
  90.     get_query!(once q:Q):T is
  91.     -- Retrieve all elements associated with the query `q'.
  92.     -- Self may be void.
  93.     if void(self) then quit end;
  94.     h::=query_hash(q).band(asize-2);    
  95.     loop e::=[h];
  96.         if is_elt_nil(e) then break!
  97.         elsif query_test(q,e) then yield e
  98.         end;
  99.         h:=h+1 end;
  100.     if h=asize-1 then h:=0;    -- hit sentinel
  101.         loop e::=[h];
  102.         if is_elt_nil(e) then break!
  103.         elsif query_test(q,e) then yield e
  104.         end;
  105.         h:=h+1 end;
  106.         assert h/=asize-1 end end; -- table mustn't be filled
  107.  
  108.     get_query(q:Q):T is
  109.     -- Retrieve the first element associated with the query arg.
  110.     -- Returns `elt_nil' if not present. Self may be void.
  111.     if void(self) then return void end;
  112.     h::=query_hash(q).band(asize-2);    
  113.     loop e::=[h];
  114.         if is_elt_nil(e) then break!
  115.         elsif query_test(q,e) then return e
  116.         end;
  117.         h:=h+1 end;
  118.     if h=asize-1 then h:=0;    -- hit sentinel
  119.         loop e::=[h];
  120.         if is_elt_nil(e) then break!
  121.         elsif query_test(q,e) then return e
  122.         end;
  123.         h:=h+1 end;
  124.         assert h/=asize-1 end;
  125.     return elt_nil end; -- table mustn't be filled
  126.     
  127.     test_query(q:Q):BOOL is
  128.     -- Test whether any elements are associated with the query `q'.
  129.     -- Self may be void.
  130.     if is_elt_nil(get_query(q)) then return false
  131.     else return true end end;
  132.     
  133.     test(e:T):BOOL is
  134.     -- True if `e' is `elt_eq' to an element contained in self. 
  135.     -- Self may be void.
  136.     if void(self) then return false end;  
  137.     h::=elt_hash(e).band(asize-2);
  138.     loop te::=[h];  
  139.         if is_elt_nil(te) then break!
  140.         elsif elt_eq(te,e) then return true
  141.         end;  
  142.         h:=h+1 end;
  143.     if h=asize-1 then        -- hit sentinel
  144.         h:=0;
  145.         loop te::=[h];
  146.         if is_elt_nil(te) then break!
  147.         elsif elt_eq(te,e) then return true
  148.         end;  
  149.         h:=h+1 end;
  150.         assert h/=asize-1 end; -- table mustn't be filled
  151.     return false end;
  152.     
  153.     get(e:T):T is
  154.     -- If `e' is `elt_eq' to a table entry, return that entry, 
  155.     -- otherwise return `elt_nil'. Useful when different objects 
  156.     -- are treated as equal (eg. a table of strings used to get a 
  157.     -- unique representative for each class of equal strings).
  158.     -- Self may be void.
  159.     if void(self) then return elt_nil end;
  160.     h::=elt_hash(e).band(asize-2);    
  161.     loop te::=[h];
  162.         if is_elt_nil(te) then break!
  163.         elsif elt_eq(te,e) then return te
  164.         end;
  165.         h:=h+1 end;
  166.     if h=asize-1 then h:=0;    -- hit sentinel
  167.         loop te::=[h];
  168.         if is_elt_nil(te) then break!
  169.         elsif elt_eq(te,e) then return te
  170.         end;
  171.         h:=h+1 end;
  172.         assert h/=asize-1 end; -- table mustn't be filled
  173.     return elt_nil end; 
  174.     
  175.     private double_size:SAME 
  176.     -- A new table of twice the size of self with self's entries
  177.     -- copied over. 
  178.     pre ~void(self) is
  179.     r::=allocate((asize-1)*2+1); 
  180.     loop r:=r.insert(elt!) end;
  181.     SYS::destroy(self);   -- The old one should never be used now.
  182.     return r end;
  183.  
  184.     private should_grow:BOOL is
  185.     return (hsize+1)*load_ratio>asize;
  186.     end;
  187.     
  188.     insert(e:T):SAME is
  189.     -- A possibly new table which includes `e'. If an entry 
  190.     -- is `elt_eq' to `e' then overwrite it with `e'.
  191.     -- Usage: `tbl:=tbl.insert(e)'. 
  192.     -- Creates a new table if void(self).
  193.     r::=self;
  194.     if is_elt_nil(e) then return r end;
  195.     if void(r) then r:=allocate(5)
  196.     elsif should_grow then r:=r.double_size end;
  197.     asz::=r.asize;
  198.     orig_h::=r.elt_hash(e).band(asz-2);
  199.     h::=orig_h;
  200.     loop te::=r[h];
  201.         if is_elt_nil(te) then break!
  202.         elsif elt_eq(te,e) then r[h]:=e; return r end;
  203.         h:=h+1 end;
  204.     if h=asz-1 then h:=0;    -- hit sentinel
  205.         loop te::=r[h];
  206.         if is_elt_nil(te) then break!
  207.         elsif elt_eq(te,e) then r[h]:=e; return r end;
  208.         h:=h+1 end;
  209.         assert h/=asz-1 end; -- table mustn't be filled     
  210.     assert not_too_many(orig_h,h); -- Look for excessive collisions
  211.     r[h]:=e; r.hsize:=r.hsize+1; return r end;
  212.     
  213.     private not_too_many(start, finish:INT):BOOL is
  214.     -- A function called in an assert to check that really
  215.     -- bad hashing isn't happening, which would probably
  216.     -- be a performance bug.  Since it is in an assert, this
  217.     -- isn't called unless checking is on.
  218.     if finish>start+50 then
  219.         #ERR+"Found a problem: excessive collisions in "
  220.          +SYS::str_for_tp(SYS::tp(self))
  221.          +", possibly due to a bad hash function in the class "
  222.          +SYS::str_for_tp(SYS::tp([start]))
  223.          +".\n";
  224.         t:T;
  225.         typecase t
  226.         when $STR then
  227.         #OUT + "Snowballing values:\n";
  228.         loop
  229.             i::=start.upto!(finish-1);
  230.             e::=[i];
  231.             h::=elt_hash(e);
  232.             typecase e
  233.             when $STR then
  234.             #OUT + i 
  235.                  + '\t' + h.hex_str 
  236.                  + '\t' + h.band(asize-2) 
  237.                  + '\t' + e.str.pretty + '\n';
  238.             end;
  239.         end;
  240.         else
  241.         end;
  242.         return false;
  243.     end;
  244.     return true;
  245.     end;
  246.     
  247.     private halve_size:SAME 
  248.     -- A new table of half the size of self with self's entries
  249.     -- copied over. 
  250.     pre ~void(self) and hsize<(asize-1)/4 is
  251.     r::=allocate((asize-1)/2+1); 
  252.     loop r:=r.insert(elt!) end;
  253.     SYS::destroy(self);   -- The old one should never be used now.
  254.     return r end;
  255.  
  256.     private should_shrink:BOOL is
  257.     return asize>=33 and hsize<(asize-1)/(load_ratio*2);
  258.     end;
  259.     
  260.     delete(e:T):SAME is
  261.     -- A possibly new table which deletes the element which an 
  262.     -- element of self that is `elt_eq' to `e' if it exists.
  263.     -- Doesn't modify the table if there is no such element.
  264.     -- Usage: `tbl:=tbl.delete(e)'. Self may be void.
  265.     if void(self) then return void end;
  266.     h::=elt_hash(e).band(asize-2);
  267.     loop te::=[h];
  268.         if is_elt_nil(te) then return self
  269.         elsif elt_eq(te,e) then break! end;
  270.         if h=asize-2 then h:=0 else h:=h+1 end end;
  271.     [h]:=elt_nil; hsize:=hsize-1; i::=h; -- h is the index of arg
  272.     -- Now check the block after h for collisions.
  273.     loop 
  274.         if i=asize-2 then i:=0 else i:=i+1 end;
  275.         te::=[i];
  276.         if is_elt_nil(te) then break! end;
  277.         hsh::=elt_hash(te).band(asize-2);
  278.         if hsh<=i then        -- block doesn't wrap around
  279.         if h<i and h>=hsh then -- hole in way
  280.             [h]:=[i]; h:=i; [i]:=elt_nil end
  281.         else            -- block wraps
  282.         if h>=hsh or h<i then -- hole in way
  283.             [h]:=[i]; h:=i; [i]:=elt_nil end end end;
  284.     if should_shrink then return halve_size
  285.     else return self end end;
  286.  
  287.     clear:SAME is
  288.     -- Clear out self, return the space if it has 17 or less entries
  289.     -- otherwise return void. Self may be void.
  290.     if void(self) then return void end;
  291.     if asize<=17 then 
  292.         hsize:=0; loop aset!(elt_nil) end; return self
  293.     else return void end end;
  294.  
  295.     is_empty:BOOL is        
  296.     -- True if the set is empty. Self may be void.
  297.     return void(self) or hsize=0 end;
  298.     
  299.     is_eq(s:SAME):BOOL is    
  300.     -- True if `s' has the same elements as self. Self may be void.
  301.     loop if ~s.test(elt!) then return false end end;
  302.     loop if ~test(s.elt!) then return false end end;
  303.     return true end;
  304.     
  305.     is_disjoint_from(s:SAME):BOOL is
  306.     -- True if self and `s' have no elements in common.
  307.     -- Self may be void.
  308.     loop if s.test(elt!) then return false end end;
  309.     return true end;
  310.     
  311.     intersects(s:SAME):BOOL is
  312.     -- True if self and `s' have elements in common.
  313.     -- Self may be void.
  314.     return ~is_disjoint_from(s) end;
  315.     
  316.     is_subset(s:SAME):BOOL is
  317.     -- True if all elements of self are contained in `s'.
  318.     -- Self may be void.
  319.     loop if ~s.test(elt!) then return false end end;
  320.     return true end;
  321.     
  322.     to_union(s:SAME):SAME is
  323.     -- The union of self and `s', modifies self.
  324.     -- Self may be void.
  325.     r::=self; loop r:=r.insert(s.elt!) end; return r end;
  326.     
  327.     union(s:SAME):SAME is
  328.     -- A new set which is the union of self and `s'.
  329.     -- Self may be void.
  330.     return copy.to_union(s) end;
  331.     
  332.     to_intersect(s:SAME):SAME is
  333.     -- The intersection of self and `s', modifies self.
  334.     -- Self may be void.
  335.     r::=self; loop r:=r.delete(s.elt!) end; return r end;
  336.     
  337.     intersect(s:SAME):SAME is
  338.     -- A new set which is the intersection of self and `s'.
  339.     -- Self may be void.
  340.     r:SAME;
  341.     loop e::=elt!; if s.test(e) then r:=r.insert(e) end end;
  342.     return r end;
  343.     
  344.     to_difference(s:SAME):SAME is
  345.     -- The difference of self and `s', modifies self.
  346.     -- Self may be void.
  347.     r::=self; loop r:=r.delete(s.elt!) end; return r end;
  348.     
  349.     difference(s:SAME):SAME is
  350.     -- A new set which is the difference between self and arg.
  351.     -- Self may be void.
  352.     r:SAME;
  353.     loop e::=elt!; if ~s.test(e) then r:=r.insert(e) end end; 
  354.     return r end;
  355.     
  356.     to_sym_difference(s:SAME):SAME is
  357.     -- The symmetric difference of self and `s', modifies self.
  358.     -- Self may be void.
  359.     r::=self;
  360.     loop e::=s.elt!;
  361.         if r.test(e) then r:=r.delete(e) else r:=r.insert(e) end end;
  362.     return r end;
  363.     
  364.     sym_difference(s:SAME):SAME is
  365.     -- A new set which is the symmetric difference between self 
  366.     -- and `s'. Self may be void.
  367.     r:SAME;
  368.     loop e::=elt!; if ~s.test(e) then r:=r.insert(e) end end;
  369.     loop e::=s.elt!; if ~test(e) then r:=r.insert(e) end end;
  370.     return r end;
  371.     
  372.     map(m:ROUT{T}:T):SAME is
  373.     -- A new set whose elements are `m' applied to those of self.
  374.     -- Self may be void.
  375.     r:SAME; loop r:=r.insert(m.call(elt!)) end; return r end;
  376.     
  377.     filter(t:ROUT{T}:BOOL):SAME is
  378.     -- A new set whose elements are those of self which satisfy `t'.
  379.     -- Self may be void.
  380.     r:SAME;
  381.     loop e::=elt!; if t.call(e) then r:=r.insert(e) end end;
  382.     return r end;
  383.  
  384.     some(t:ROUT{T}:BOOL):BOOL is
  385.     -- True if some element of self satisfies `t'.
  386.     -- Self may be void.
  387.     loop if t.call(elt!) then return true end end end;
  388.  
  389.     every(t:ROUT{T}:BOOL):BOOL is
  390.     -- True if every element of self satisfies `t'.
  391.     -- Self may be void.
  392.     loop if ~t.call(elt!) then return false end end;
  393.     return true end;
  394.  
  395.     notany(t:ROUT{T}:BOOL):BOOL is
  396.     -- True if none of the elements of self satisfies `t'.
  397.     -- Self may be void.
  398.     loop if t.call(elt!) then return false end end;
  399.     return true end;
  400.     
  401.     notevery(t:ROUT{T}:BOOL):BOOL is
  402.     -- True if not every element of self satisfies `t'.
  403.     -- Self may be void.
  404.     loop if ~t.call(elt!) then return true end end;
  405.     return false end;
  406.     
  407. end; -- class FQSET{Q,T}
  408.  
  409. -------------------------------------------------------------------
  410.